home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
mail.altrad.com
/
2015.02.mail.altrad.com.tar
/
mail.altrad.com
/
TEST
/
office deutch
/
PROPLUS.WW
/
PROPLSWW.CAB
/
XL12CNV.EXE
/
HTML
/
3000
Wrap
Text File
|
2006-10-26
|
3KB
|
88 lines
<SCRIPT language=VBScript>
DIM xlApp
DIM xlWorkBook
ON ERROR RESUME NEXT
'Set IE variables and get the URL
SET ieParentWin = external.menuArguments
ieSrcURL = ieParentWin.location.href
fTableSel = FALSE
SET ieSrcElem = ieParentWin.event.srcElement
IF ERR = 0 AND UCASE(ieParentWin.document.selection.type) = "NONE" THEN
tagName = UCASE(ieSrcElem.tagName)
DO UNTIL tagName = "TABLE" OR tagName = "BODY"
SET ieSrcElem = ieSrcElem.parentElement
tagName = UCASE(ieSrcElem.tagName)
LOOP
IF tagName = "TABLE" THEN
tagParentName = tagName
SET ieParent = ieSrcElem
DO UNTIL tagParentName = "BODY" OR tagParentName = "VIEW"
SET ieParent = ieParent.parentElement
tagParentName = UCASE(ieParent.tagName)
LOOP
IF tagParentName <> "VIEW" THEN
fTableSel = TRUE
IF ieSrcElem.ID <> "" THEN
ieSrcConnect = ieSrcElem.ID
ELSE
SET ieTables = ieParentWin.document.all.tags("table")
ieSrcConnect = 1
FOR EACH ieTable IN ieTables
IF ieTable.sourceIndex = ieSrcElem.sourceIndex THEN
EXIT FOR
END IF
ieSrcConnect = ieSrcConnect + 1
NEXT
END IF
END IF
END IF
END IF
SET xlApp = CreateObject("Excel.Application")
ON ERROR GOTO 0
SET xlWorkbook = xlApp.Workbooks.Add
ON ERROR RESUME NEXT
xlApp.Visible = True
IF fTableSel THEN
webQuerySourceHRef = ieSrcElem.getAttribute("o:WebQuerySourceHRef")
IF webQuerySourceHRef <> "" THEN
SET xlQueryTable = xlWorkbook.Worksheets(1).QueryTables.Add("URL;" & webQuerySourceHRef, xlWorkbook.WorkSheets(1).Cells(1,1))
xlQueryTable.EditWebPage = ieSrcURL
ELSE
SET xlQueryTable = xlWorkbook.Worksheets(1).QueryTables.Add("URL;" & ieSrcURL, xlWorkbook.WorkSheets(1).Cells(1,1))
xlQueryTable.EditWebPage = ""
END IF
xlQueryTable.FieldNames = True
xlQueryTable.RowNumbers = False
xlQueryTable.FillAdjacentFormulas = False
xlQueryTable.PreserveFormatting = True
xlQueryTable.RefreshOnFileOpen = False
xlQueryTable.BackgroundQuery = True
xlQueryTable.RefreshStyle = 0 'xlOverwriteCells
xlQueryTable.SavePassword = False
xlQueryTable.SaveData = True
xlQueryTable.AdjustColumnWidth = True
xlQueryTable.RefreshPeriod = 0
xlQueryTable.WebSelectionType = 3 'xlSpecifiedTables
xlQueryTable.WebFormatting = 3 'xlWebFormattingNone
xlQueryTable.WebTables = ieSrcConnect
xlQueryTable.WebPreFormattedTextToColumns = True
xlQueryTable.WebConsecutiveDelimitersAsOne = True
xlQueryTable.WebSingleBlockTextImport = False
xlQueryTable.WebDisableDateRecognition = False
xlQueryTable.WebDisableRedirections = False
xlQueryTable.Refresh
ELSE
xlApp.Dialogs(667).Show ieSrcURL
END IF
</Script>